home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_bas / gapdr / door.bas next >
BASIC Source File  |  1989-01-17  |  15KB  |  336 lines
  1. '****************************************************************************
  2. '*  Copyright (C) 1988,1989 The GAP Development Company
  3. '*
  4. '*  All Rights Reserved
  5. '*
  6. '*
  7. '*  DOOR.BAS
  8. '*
  9. '*  Demonstration program for GAPQBDR
  10. '*
  11. '*  To compile : bc door;
  12. '*  To link    : link door,,NUL.MAP,+gapqbdr
  13. '*
  14. '*  Program will need access to DOOR.CNF, DOOR.SYS, GAPBBS.CNF, GAPDOS.DAT
  15. '*
  16. '****************************************************************************
  17.  
  18.  
  19.    '***********************************************************************
  20.    '*  Before doing ANYTHING else, include the following file.            *
  21.    '***********************************************************************
  22.  
  23. ' $INCLUDE: 'GAPQBDR.BI'
  24.  
  25.  
  26.    '***********************************************************************
  27.    '*  Declare any local variables prior to use                           *
  28.    '***********************************************************************
  29.  
  30.    DIM oldbell AS INTEGER                 ' so we dont make sysop mad
  31.    DIM bobo AS INTEGER                    ' error return codes
  32.    DIM anystring AS STRING                ' string used for most everything
  33.    DIM response AS STRING                 ' for getting responses
  34.    DIM menu AS STRING                     ' for building a menu
  35.    DIM prompt AS STRING                   ' for the command prompt
  36.  
  37.  
  38.    '***********************************************************************
  39.    '*  Begin main line code here                                          *
  40.    '***********************************************************************
  41.  
  42.    '***********************************************************************
  43.    '*  Before doing ANYTHING else, initialize the door with the following *
  44.    '*  two function calls.                                                *
  45.    '*  Then, if you have any configuration options, line input them in    *
  46.    '*  and close file # 1.                                                *
  47.    '***********************************************************************
  48.  
  49.    CALL read.cnf("DOOR.CNF")              ' read door configuration file
  50.    CALL init.door                         ' initialize the door
  51.  
  52.    close #1                               ' we dont have any configuration
  53.                                           ' options so we will just close
  54.  
  55.  
  56.    '***********************************************************************
  57.    '*  Now, we are going to keep track of the time credit variable that   *
  58.    '*  is stored in the GAPDOS.DAT file.  We are going to do this because *
  59.    '*  we are such nice people and we want to credit the caller for the   *
  60.    '*  time spent during our chat demonstration.  Remember, at the        *
  61.    '*  beginning of the program, after initializing the door, is the      *
  62.    '*  place to do this because the variable 'timecredit' is initialized  *
  63.    '*  at doors beginning.                                                *
  64.    '*                                                                     *
  65.    '*  NOTE!  This function will fail (the reason for bobo) if GAPDOS.DAT *
  66.    '*  does not exist (which it will not unless this program is being     *
  67.    '*  tested via the BBS door routines.  If you need to test this        *
  68.    '*  feature, you will need to have a backup copy of GAPDOS.DAT that    *
  69.    '*  can be placed in your BBS default directory prior to running this  *
  70.    '*  demo!                                                              *
  71.    '***********************************************************************
  72.  
  73.    bobo = read.gapdos%                    ' read the system file
  74.  
  75.    IF bobo = 0 THEN
  76.       anystring = "GAPDOS.DAT says you have " + STR$(gapdos.timecredit)
  77.       anystring = anystring + " time credits (in minutes)."
  78.  
  79.       CALL show.mess(anystring, NO, YES)
  80.    ELSE
  81.       CALL nl(2)                           ' display a couple of blank lines
  82.  
  83.       CALL ansi(BRED)                      ' Humm, error time!
  84.       CALL show.mess("Could Not Open GAPDOS.DAT!", YES, YES)
  85.    END IF
  86.  
  87.    CALL nl(2)                              ' display a couple of blank lines
  88.  
  89.  
  90.    '***********************************************************************
  91.    '*  Change the color prior to displaying a prompt.  Send a prompt to   *
  92.    '*  the caller and await an answer.                                    *
  93.    '***********************************************************************
  94.  
  95.    CALL ansi(BGREEN)                      ' set default color to Green
  96.  
  97.    CALL show.mess("Please Enter Your Name : ", YES, NO) ' main output routine
  98.  
  99.    response = SPACE$(30)                  ' must initialize all variables
  100.                       ' passed to get.string
  101.    CALL get.string(response)              ' now get the caller's name
  102.  
  103.    CALL nl(1)                             ' display a blank line
  104.  
  105.  
  106.    '***********************************************************************
  107.    '*  An alternative way to change colors on the fly is to do it         *
  108.    '*  inline.  It is also a bit faster since fewer function calls are    *
  109.    '*  made.  But note that to change colors like this, you have to test  *
  110.    '*  if the caller is in color mode.                                    *
  111.    '***********************************************************************
  112.  
  113.    IF c.olor = 1 THEN
  114.       anystring = BCYAN + "Your name is : " + BRED + response + BCYAN + "."
  115.    ELSE
  116.       anystring = "Your name is : " + response + "."
  117.    END IF
  118.  
  119.    CALL show.mess(anystring, NO, YES)' tell caller what was entered
  120.  
  121.    CALL nl(1)                        ' display a blank line
  122.  
  123.    CALL ansi(BGREEN)                 ' change colors
  124.  
  125.    call show.mess("But on the BBS, your First Name is : "+first +".",NO,YES)
  126.  
  127.    CALL nl(1)                        ' display a blank line
  128.  
  129.    CALL pause                        ' wait for a key press before continuing
  130.  
  131.    CALL nl(2)                        ' display a couple of blank lines
  132.  
  133.  
  134.    '***********************************************************************
  135.    '*  The next example is the WRONG way to display a color string since  *
  136.    '*  it does not bother checking if the user is in color mode.          *
  137.    '*  The correct way is to check the c.olor variable.  If it is a 1     *
  138.    '*  then it is safe to send color.  This is exactly what ansi() does.  *
  139.    '***********************************************************************
  140.  
  141.    anystring = BRED + "I'm going to mess up your black & white screen." + CRLF
  142.    anystring = anystring + "Because I'm not checking to see if you have " + CRLF
  143.    anystring = anystring + BWHITE + "Color turned on!!!"
  144.  
  145.    CALL show.mess(anystring, NO, YES)
  146.  
  147.    CALL nl(2)                        ' display a couple of blank lines
  148.  
  149.  
  150.  
  151.    '***********************************************************************
  152.    '*  It is now time to page the sysop.  Just in case the sysop has his  *
  153.    '*  page bell turned off, we are going to cheat a bit and turn it on.  *
  154.    '*  For demonstration purposes only, you see!                          *
  155.    '*  We will also demonstrate how to obtain and display the time left.  *
  156.    '*                                                                     *
  157.    '*  Note that the 'timeleft' variable is automatically updated by the  *
  158.    '*  input routines.  If you need to make sure that it is current, you  *
  159.    '*  can always call time.left() prior to using it.  Since 'timeleft'   *
  160.    '*  is an integer, you will need to convert it to a string and then    *
  161.    '*  trim the leading space from it.                                    *
  162.    '***********************************************************************
  163.  
  164.    DO
  165.       CALL nl(1)
  166.  
  167.       if c.olor = 1 then
  168.          anystring = YELLOW + "["+BRED + LTRIM$(str$(timeleft))+" mins" + YELLOW + "] To Page the Sysop, type a 'P' : "
  169.       else
  170.          anystring = "["+ LTRIM$(str$(timeleft))+" mins] To Page the Sysop, type a 'P' : "
  171.       end if
  172.  
  173.       CALL show.mess(anystring, NO, NO)
  174.  
  175.       response = " "                 ' must initialize get.string variable
  176.       CALL get.string(response)      ' get the caller's response
  177.  
  178.    LOOP WHILE response <> "P"        ' loop till valid response
  179.        
  180.    '***********************************************************************
  181.    '*  We are going to override the sysop's page bell flag so we can      *
  182.    '*  can hear the bell.  This is not a good thing to do as it will tend *
  183.    '*  to anger the sysop if a door program does not honor his BBS        *
  184.    '*  settings.  Sorry sysop.  We'll put the bell flag back the way it   *
  185.    '*  was when we are finished.                                          *
  186.    '***********************************************************************
  187.  
  188.    oldbell = bell                    ' keep track of old bell setting
  189.    bell = 1                          ' turn sysop's page bell on
  190.  
  191.    CALL pagesysop                    ' now page the sysop
  192.  
  193.    bell = oldbell                    ' restore old bell setting
  194.  
  195.  
  196.    '***********************************************************************
  197.    '*  Lets now display a file.  We want to display a color version of    *
  198.    '*  the file if the caller is in color mode and an ascii version of    *
  199.    '*  the file if the caller is in non-color mode.  So, we will ask the  *
  200.    '*  programmer to supply the name of a BBS welcome file.               *
  201.    '*  The programmer should supply the name of the non-color version of  *
  202.    '*  the file (IE, no 'G' at the end of the name).                      *
  203.    '*                                                                     *
  204.    '*  The show.file() routine makes certain assumptions about the file   *
  205.    '*  name being passed to it.  It assumes that you are calling it with  *
  206.    '*  a path and file name for a file that you know is or should be      *
  207.    '*  present.  Show.file() will attempt to find the file, but if it     *
  208.    '*  cannot, it simply returns (no error code).                         *
  209.    '*  If you are gathering input from the user, as this example does,    *
  210.    '*  you may want to call a.ccess() to first see if the file exists.    *
  211.    '***********************************************************************
  212.  
  213.  
  214.    CALL nl(2)                        ' display a couple of blank lines
  215.  
  216.    do
  217.  
  218.       CALL ansi(YELLOW)              ' set a default color
  219.  
  220.       CALL show.mess("Enter full path name to your BBS Welcome File : ", NO, NO)
  221.  
  222.       response = SPACE$(65)          ' must initialize variable
  223.       CALL get.string(response)      ' get the path and name of file to show
  224.  
  225.       if a.ccess% (response) <> 0 then     ' does file exist?
  226.          call nl(1)
  227.          call ansi(BRED)                   ' no, tell them in RED!
  228.          call show.mess("File Not Found!",YES,YES)
  229.          call nl(1)
  230.       else
  231.          exit do                           ' yes, go show it
  232.       end if
  233.    loop                              ' till valid file name entered
  234.  
  235.    call ansi (YELLOW)                ' reset default color
  236.  
  237.    CALL show.file(response)          ' now show the file.
  238.  
  239.  
  240.  
  241.    '***********************************************************************
  242.    '*  Lets see what is going on with the time credit variable.           *
  243.    '*  Depending upon how long the programmer chatted with his/her self,  *
  244.    '*  or if the up or down arrow keys were pressed at any time, it could *
  245.    '*  be quite different from what GAP wrote to the GAPDOS.DAT file!     *
  246.    '***********************************************************************
  247.  
  248.    
  249.    IF bobo = 0 THEN                  ' only if we could 1st read the file
  250.       CALL nl(2)                     ' display a couple of blank lines
  251.       CALL ansi(BGREEN)              ' set a default color
  252.  
  253.       CALL show.mess("GAPDOS timecredit was " + STR$(gapdos.timecredit) + " mins.", NO, YES)
  254.  
  255.       CALL ansi(BWHITE)
  256.  
  257.       CALL show.mess("We are going to explicitly ADD 20 minutes.", NO, YES)
  258.  
  259.       timecredit = timecredit + 20      ' add 20 minutes
  260.  
  261.       gapdos.timecredit = gapdos.timecredit + timecredit
  262.  
  263.       bobo = write.gapdos%           ' update GAPDOS.DAT
  264.       CALL nl(1)                     ' show a blank line
  265.       CALL ansi(BGREEN)
  266.       CALL show.mess("GAPDOS timecredit now equals " + STR$(gapdos.timecredit) + " mins.", NO, YES)
  267.  
  268.       CALL ansi(YELLOW)              ' set a default color
  269.  
  270.       CALL show.mess("Any difference came from CHAT or Up/Down Arrow Keys!", YES, NO)
  271.  
  272.    END IF
  273.     
  274.    CALL nl(2)                        ' display a couple of blank lines
  275.  
  276.    CALL pause                        ' pause before continuing
  277.  
  278.  
  279.    '***********************************************************************
  280.    '*  Lets now build some menus all at once.                             *
  281.    '*  These menus were created with an ANSI editor.  This is perhaps the *
  282.    '*  fastest and easiest way to create menus.  It is also faster to     *
  283.    '*  display a menu all at once instead of displaying each line of the  *
  284.    '*  menu one at a time.                                                *
  285.    '***********************************************************************
  286.  
  287.    if c.olor = 1 then
  288.       menu = "C╔══════════════════════════════════════╗"+CRLF
  289.       menu = menu + "   ║CMain MenuC║"+CRLF
  290.       menu = menu + "   ╟──────────────────────────────────────╢"+CRLF
  291.       menu = menu + "   ║C║"+CRLF
  292.       menu = menu + "   ║  [T]op PlayersC[P]age Sysop  ║"+CRLF
  293.       menu = menu + "   ║  [H]elpC[U]ser Stats  ║"+CRLF
  294.       menu = menu + "   ║  [Q]uitC[G]ambleC║"+CRLF
  295.       menu = menu + "   ╚══════════════════════════════════════╝"+CRLF+CRLF
  296.    else   
  297.       menu = "   ╔══════════════════════════════════════╗"+CRLF
  298.       menu = menu + "   ║              Main Menu               ║"+CRLF
  299.       menu = menu + "   ╟──────────────────────────────────────╢"+CRLF
  300.       menu = menu + "   ║                                      ║"+CRLF
  301.       menu = menu + "   ║  [T]op Players         [P]age Sysop  ║"+CRLF
  302.       menu = menu + "   ║  [H]elp                [U]ser Stats  ║"+CRLF
  303.       menu = menu + "   ║  [Q]uit                [G]amble      ║"+CRLF
  304.       menu = menu + "   ╚══════════════════════════════════════╝"+CRLF+CRLF
  305.    end if
  306.  
  307.    do
  308.       call clear.scr                 ' fist clear the screen
  309.  
  310.       call nl(2)                     ' do a couple of blank lines
  311.  
  312.       if c.olor = 1 then
  313.          prompt = YELLOW + "["+BRED + LTRIM$(str$(timeleft))+" mins" + YELLOW + "] Main Command : "
  314.       else
  315.          prompt = "["+ LTRIM$(str$(timeleft))+" mins] Main Command : "
  316.       end if
  317.      
  318.       call show.mess(menu,NO,YES)    ' show the menu
  319.       call show.mess(prompt,NO,NO)   ' show the prompt
  320.  
  321.       response = " "                 ' initialize response
  322.       call get.string(response)      ' get user input
  323.  
  324.       if response <> "Q" then
  325.          call nl(2)
  326.          call ansi(BRED)
  327.          call show.mess("Only Menu Choice 'Q' Is Working!",YES,YES)
  328.          call nl(1)
  329.          call pause
  330.       end if
  331.  
  332.    loop until response = "Q"
  333.  
  334. END
  335.  
  336.